home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak 1 / Leisure Game Pak I.iso / lpgame1 / 04 / source / gadget.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-17  |  11KB  |  380 lines
  1. UNIT    GADGET;
  2.  
  3. INTERFACE
  4.  
  5. CONST    GAD_PUSHED     = TRUE;
  6.     GAD_NOT_PUSHED  = FALSE;
  7.  
  8.     GAD_KEEP    = TRUE;
  9.         GAD_NO_KEEP    = FALSE;
  10.     NO_FILL        = -1;        { frame fill-color for no fill }
  11.  
  12.     { parameters in GADGET.refresh }
  13.     GAD_FLIP_STATE  = TRUE;        { flip PUSHED-state }
  14.         GAD_KEEP_STATE  = FALSE;    { don't flip it, keep it }
  15.  
  16. TYPE    POINT_TYPE = OBJECT
  17.         x, y     : WORD;
  18.                 CONSTRUCTOR      init(p_x, p_y : WORD);
  19.         PROCEDURE    get_pos(VAR  p_x, p_y : WORD);
  20.     END;  { POINT_TYPE }
  21.  
  22.     FRAME_TYPE = OBJECT(POINT_TYPE)
  23.         width, height     : WORD;
  24.                 old_col        : WORD;
  25.         in_col         : INTEGER;     (* may be -1 = NO_FILL *)
  26.         color        : ARRAY[BOOLEAN] OF WORD;
  27.                 thickness    : BYTE;
  28.                 pushed, mouse   : BOOLEAN;
  29.         CONSTRUCTOR    init(f_x, f_y,
  30.                      f_width, f_height  : WORD;
  31.                      f_thickness        : BYTE;
  32.                      f_in_col         : INTEGER;
  33.                      f_leftup_col,
  34.                      f_rightdn_col     : WORD;
  35.                      f_pushed, f_mouse    : BOOLEAN);
  36.                 PROCEDURE    show;    VIRTUAL;
  37.         PROCEDURE    hide;   VIRTUAL;
  38.         END;  { FRAME_TYPE }
  39.  
  40.     GADGET_TYPE = OBJECT(FRAME_TYPE)
  41.                 active          : BOOLEAN;    (* i.e. visible *)
  42.                 keep        : BOOLEAN;    (* keeps its pushed-state *)
  43.                 text        : STRING[30];
  44.                 text1_end    : BYTE;
  45.         (* the text may consist of 2 subtexts :
  46.            characters 1..text1_end are displayed if gadget NOT_PUSHED
  47.                              (text1_end+1)..LENGTH(text) ... if   PUSHED
  48.                    if  (text1_end = 0)  then  "same text for both states" *)
  49.                 textcol        : BYTE;
  50.         CONSTRUCTOR    init(g_x, g_y,
  51.                      g_width,
  52.                      g_height        : WORD;
  53.                      g_in_col       : INTEGER;
  54.                      g_leftup_col,
  55.                      g_rightdn_col : WORD;
  56.                        g_pushed,
  57.                                      g_mouse,
  58.                                      g_keep       : BOOLEAN;
  59.                                      g_text       : STRING;
  60.                                      g_text1_end   : BYTE;
  61.                      g_textcol       : BYTE);
  62.         PROCEDURE    show;   VIRTUAL;
  63.         PROCEDURE    hide;   VIRTUAL;
  64.         { refresh gadget , i.e. hide it, then show it again (eventually flip state) }
  65.         PROCEDURE    refresh(flip_it : BOOLEAN);
  66.                 PROCEDURE    set_state(g_pushed : BOOLEAN);
  67.         FUNCTION    mouse_hit(mx, my : WORD) : BOOLEAN;
  68.         FUNCTION    handle_mouse_click : BOOLEAN;
  69.                 FUNCTION    gad_active : BOOLEAN;
  70.         FUNCTION    gad_pushed : BOOLEAN;
  71.         END;  { GADGET_TYPE }
  72.  
  73.  
  74. { ShadowTextXY supplies two-color text }
  75. PROCEDURE    ShadowTextXY(x, y            : WORD;
  76.                  up_col, dn_col : BYTE;
  77.                  text         : STRING);
  78.  
  79. IMPLEMENTATION
  80.  
  81. USES     GRAPH,
  82.     MOUSE;        (*  for the gadget routines  *)
  83.  
  84. { ShadowTextXY supplies two-color text }
  85. PROCEDURE    ShadowTextXY(x, y            : WORD;
  86.                  up_col, dn_col : BYTE;
  87.                  text         : STRING);
  88. BEGIN
  89.         SetColor(dn_col);    OutTextXY(SUCC(x), SUCC(y), text);
  90.         SetColor(up_col);    OutTextXY(x, y, text);
  91. END;    { ShadowTextXY }
  92.  
  93.  
  94. { ...................  methods for POINT_TYPE  ......................... }
  95.  
  96. CONSTRUCTOR    POINT_TYPE.init(p_x, p_y : WORD);
  97. BEGIN
  98.     SELF.x := p_x;    SELF.y := p_y;
  99. END;    { POINT_TYPE.init }
  100.  
  101.  
  102. PROCEDURE    POINT_TYPE.get_pos(VAR  p_x, p_y : WORD);
  103. BEGIN
  104.     p_x := SELF.x;    p_y := SELF.y;
  105. END;    { POINT_TYPE.get_pos }
  106.  
  107.  
  108. { ...................  methods for FRAME_TYPE  ......................... }
  109.  
  110. CONSTRUCTOR    FRAME_TYPE.init(f_x, f_y,
  111.                 f_width, f_height  : WORD;
  112.                 f_thickness       : BYTE;
  113.                 f_in_col       : INTEGER;
  114.                 f_leftup_col,
  115.                 f_rightdn_col        : WORD;
  116.                 f_pushed, f_mouse   : BOOLEAN);
  117. BEGIN
  118.     POINT_TYPE.init(f_x, f_y);
  119.     SELF.width := f_width;        SELF.height := f_height;
  120.     SELF.in_col := f_in_col;
  121.     SELF.color[GAD_NOT_PUSHED] := f_leftup_col;
  122.     SELF.color[GAD_PUSHED] := f_rightdn_col;
  123.         SELF.thickness := f_thickness;
  124.         SELF.pushed := f_pushed;
  125.         SELF.mouse := f_mouse;
  126. END;    { FRAME_TYPE.init }
  127.  
  128.  
  129. PROCEDURE    FRAME_TYPE.show;
  130. VAR     halfthick : INTEGER;
  131.     oldLINES  : LineSettingsType;
  132.     oldFILLS  : FillSettingsType;
  133.     oldCOLOR  : WORD;
  134. BEGIN
  135.         oldCOLOR := GetColor;
  136.         GetLineSettings(oldLINES);
  137.         GetFillSettings(oldFILLS);
  138.         SetLineStyle(SOLIDLN, 0, SELF.thickness);
  139.     IF  (SELF.mouse)  THEN    HideMouse;
  140.  
  141.            SELF.old_col := GetPixel(SELF.x, SELF.y);
  142.  
  143.         IF  (SELF.in_col <> NO_FILL)  THEN
  144.         BEGIN
  145.             SetFillStyle (SOLIDFILL, SELF.in_col);
  146.             Bar(SELF.x, SELF.y, SELF.x + PRED(SELF.width), SELF.y + PRED(SELF.height));
  147.         END;  { IF }
  148.  
  149.         halfthick := SUCC(SELF.thickness) DIV 2;
  150.  
  151.         { the left and upper lines in NOT_PUSHED-color}
  152.         SetColor(SELF.color[NOT(SELF.pushed)]);
  153.  
  154.         { goto lower-left corner }
  155.         MoveTo(SELF.x - halfthick, SELF.y + PRED(SELF.height) + halfthick);
  156.         { line to upper-left corner }
  157.         LineRel(0, -(SELF.thickness + SELF.height));
  158.         { line to upper-right corner }
  159.     LineRel(SELF.width + SELF.thickness, 0);
  160.  
  161.         { the right and lower lines in PUSHED-color }
  162.         SetColor(SELF.color[SELF.pushed]);
  163.  
  164.         { line to lower-right corner }
  165.         LineRel(0, SELF.thickness + SELF.height);
  166.         { line back to lower-left corner }
  167.     LineRel(-(SELF.width + SELF.thickness), 0);
  168.  
  169.     IF  (SELF.mouse)  THEN  ShowMouse;
  170.  
  171.         { back to old grafics settings }
  172.         SetColor(oldCOLOR);
  173.         WITH  oldLINES  DO
  174.         SetLineStyle(LineStyle, Pattern, Thickness);
  175.         WITH  oldFILLS  DO
  176.         SetFillStyle(Pattern, Color);
  177. END;    { FRAME_TYPE.show }
  178.  
  179.  
  180. PROCEDURE    FRAME_TYPE.hide;
  181. VAR    oldFILLS : FillSettingsType;
  182.     oldLINES : LineSettingsType;
  183.     oldCOLOR : WORD;
  184. BEGIN
  185.     IF  (SELF.mouse)  THEN  HideMouse;
  186.  
  187.         IF  (SELF.in_col = NO_FILL)  THEN
  188.         BEGIN
  189.         oldCOLOR := GetColor;
  190.             SetColor(SELF.old_col);
  191.  
  192.             GetLineSettings(oldLINES);
  193.             SetLineStyle(SOLIDLN, 0, SELF.thickness);
  194.  
  195.             Rectangle(SELF.x, SELF.y,
  196.               SELF.x + PRED(SELF.width),
  197.                   SELF.y + PRED(SELF.height));
  198.  
  199.             SetColor(oldCOLOR);
  200.             WITH  oldLINES  DO
  201.             SetLineStyle(LineStyle, Pattern, Thickness);
  202.         END  { IF }
  203.         ELSE
  204.         BEGIN
  205.             GetFillSettings(oldFILLS);
  206.             SetFillStyle (SOLIDFILL, SELF.old_col);
  207.  
  208.             Bar(SELF.x - SELF.thickness, SELF.y - SELF.thickness,
  209.             SELF.x + PRED(SELF.width) + SELF.thickness,
  210.             SELF.y + PRED(SELF.height) + SELF.thickness);
  211.  
  212.             WITH  oldFILLS  DO
  213.             SetFillStyle(Pattern, Color);
  214.         END;  { ELSE }
  215.  
  216.     IF  (SELF.mouse)  THEN  ShowMouse;
  217.  
  218. END;    { FRAME_TYPE.hide }
  219.  
  220.  
  221. { ...................  methods for GADGET_TYPE  ........................ }
  222.  
  223. CONSTRUCTOR    GADGET_TYPE.init(g_x, g_y,
  224.                  g_width,
  225.                  g_height    : WORD;
  226.                  g_in_col    : INTEGER;
  227.                  g_leftup_col,
  228.                  g_rightdn_col  : WORD;
  229.                    g_pushed,
  230.                                  g_mouse,
  231.                                  g_keep        : BOOLEAN;
  232.                                  g_text           : STRING;
  233.                                  g_text1_end       : BYTE;
  234.                  g_textcol    : BYTE);
  235. BEGIN
  236.     FRAME_TYPE.init(g_x, g_y, g_width, g_height,
  237.                 NORMWIDTH,
  238.             g_in_col, g_leftup_col, g_rightdn_col,
  239.             g_pushed, g_mouse);
  240.     SELF.text     := g_text;
  241.     SELF.text1_end  := g_text1_end;
  242.     SELF.textcol     := g_textcol;
  243.         SELF.keep    := g_keep;
  244.         SELF.active     := FALSE;
  245. END;    { GADGET_TYPE.init }
  246.  
  247.  
  248. PROCEDURE    GADGET_TYPE.show;
  249. VAR    txtcol   : WORD;
  250.     act_text : STRING;
  251. BEGIN
  252.     FRAME_TYPE.show;
  253.  
  254.     IF  (SELF.mouse)  THEN    HideMouse;
  255.         IF  (SELF.pushed)  THEN
  256.         BEGIN
  257.             txtcol := 0;    {should be BLACK}
  258.                 (* get the text's second part for PUSHED gadgets,
  259.            if text1_end = 0 then it's the whole text, ok! *)
  260.                 act_text := COPY(text, text1_end+1, LENGTH(text));
  261.         END
  262.         ELSE
  263.         BEGIN
  264.         txtcol := SELF.textcol;
  265.                 IF  (text1_end > 0)  THEN
  266.                     (* show the first part *)
  267.                     act_text := COPY(text, 1, text1_end)
  268.                 ELSE
  269.             (* there's only one text for both states *)
  270.                     act_text := text;
  271.         END;
  272.  
  273.      ShadowTextXY(SELF.x + SUCC(SELF.width - TextWidth(act_text)) DIV 2,
  274.              SELF.y + SUCC(SELF.height - TextHeight(act_text)) DIV 2,
  275.                      txtcol, SELF.textcol - txtcol,
  276.              act_text);
  277.     IF  (SELF.mouse)  THEN    ShowMouse;
  278.  
  279.         SELF.active := TRUE;
  280.  
  281. END;    { GADGET_TYPE.show }
  282.  
  283.  
  284. PROCEDURE    GADGET_TYPE.hide;
  285. BEGIN
  286.         IF  (SELF.active)  THEN
  287.             FRAME_TYPE.hide;    {don't hide it if it's not there}
  288.  
  289.     SELF.active := FALSE;
  290. END;    { GADGET_TYPE.hide }
  291.  
  292.  
  293. { refresh gadget , i.e. hide it, then show it again (eventually flip state) }
  294. PROCEDURE    GADGET_TYPE.refresh(flip_it : BOOLEAN);
  295. BEGIN
  296.     SELF.pushed := SELF.pushed  XOR  flip_it;
  297.     SELF.hide;
  298.         SELF.show;
  299. END;    { GADGET_TYPE.refresh }
  300.  
  301.  
  302. { set new pushed-state }
  303. PROCEDURE    GADGET_TYPE.set_state(g_pushed : BOOLEAN);
  304. BEGIN
  305.     SELF.pushed := g_pushed;
  306. END;    { GADGET_TYPE.set_state }
  307.  
  308.  
  309. { tests whether coordinates (mx, my) are in gadget }
  310. FUNCTION    GADGET_TYPE.mouse_hit(mx, my : WORD) : BOOLEAN;
  311. { in_rect(x,y,x1,y1,dx,dy) <=> (x,y) is in (x1,y1)-(x1+dx-1, y1+dy-1) }
  312. FUNCTION    in_rect(x, y, x1, y1, dx, dy : INTEGER) : BOOLEAN;
  313. BEGIN
  314.     in_rect := (x >= x1) AND (x < x1+dx) AND (y >= y1) AND (y < y1+dy);
  315. END;    { in_rect }
  316. BEGIN
  317.     mouse_hit := SELF.active  AND
  318.              in_rect(mx, my, SELF.x, SELF.y, SELF.width, SELF.height);
  319. END;    { GADGET_TYPE.mouse_hit }
  320.  
  321.  
  322. { handles mouseclick (inclusive reading mouse, drawing graphics) }
  323. FUNCTION    GADGET_TYPE.handle_mouse_click : BOOLEAN;
  324. VAR    dummy, mx, my     : WORD;
  325.         was_pushed,                (* push state on call *)
  326.     new_hit, old_hit : BOOLEAN;    (* hit status: new, until now *)
  327. BEGIN
  328.         old_hit  := FALSE;
  329.  
  330.         dummy := GetMousePos(mx, my);
  331.         IF  (SELF.mouse_hit(mx, my)) THEN
  332.     BEGIN
  333.         was_pushed := SELF.pushed;
  334.  
  335.             WHILE  (GetMousePos(mx, my) = LEFTMOUSEBUTTON)  DO
  336.             BEGIN
  337.                     new_hit := SELF.mouse_hit(mx, my);
  338.  
  339.                         IF  (old_hit  XOR  new_hit)  THEN
  340.                         BEGIN
  341.                                 (* refresh it, only if necessary *)
  342.                                 IF  (SELF.pushed XOR (new_hit OR was_pushed))  THEN
  343.                 BEGIN
  344.                                         SELF.pushed := new_hit OR was_pushed;
  345.                     SELF.refresh(FALSE);
  346.                                 END;  (* IF *)
  347.  
  348.                             old_hit := new_hit;
  349.                         END;  (* IF *)
  350.             END;  (* WHILE *)
  351.         END;  (* IF *)
  352.  
  353.         { if it was pressed before button was released then refresh it }
  354.     IF  (old_hit)  THEN
  355.         BEGIN
  356.         IF  (SELF.pushed  XOR  (SELF.keep AND NOT(was_pushed)))  THEN
  357.         BEGIN
  358.             SELF.pushed := NOT(SELF.pushed);
  359.                     SELF.refresh(FALSE);
  360.                 END;  (* IF *)
  361.         END;  (* IF old_hit *)
  362.  
  363.         handle_mouse_click := old_hit;
  364.  
  365. END;    { GADGET_TYPE.handle_mouse_click }
  366.  
  367.  
  368. { returns TRUE if gadget is active (i.e. visible) }
  369. FUNCTION    GADGET_TYPE.gad_active : BOOLEAN;
  370. BEGIN
  371.     gad_active := SELF.active;
  372. END;    { gad_active }
  373.  
  374. { returns TRUE if gadget is pressed }
  375. FUNCTION    GADGET_TYPE.gad_pushed : BOOLEAN;
  376. BEGIN
  377.     gad_pushed := SELF.pushed;
  378. END;    { gad_pushed }
  379.  
  380. END.    { UNIT GADGET }